home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
AMIGA
/
AMICUS
/
AMICUS03.ADF
/
AmigaBasicProgs
/
superterm
< prev
next >
Wrap
Text File
|
1986-03-17
|
16KB
|
797 lines
REM - Superterm V1.0 by Kelly Kauffman
REM - January 3, 1985
REM
'
'
'
'
PRINT "Do you want CTRL-C's to end the program (E) or actually send a CTRL-C"
PRINT "through the modem (S) Input Choice (Either E or S)";
INPUT choice$
IF choice$="S" OR choice$="s" THEN
BREAK ON
ON BREAK GOSUB breaker
END IF
DIM mac$(10)
DIM bf$(256)
GOSUB gettem
WIDTH 77
rcp(1)=1
fl(1)=1
fl(2)=1
cp(2)=1
DIM bd(12)
F$="COM1:"
menusel=3
GOSUB baud
menusel=1
GOSUB trm
menusel=3
GOSUB trm
menusel=6
GOSUB trm
menusel=4
GOSUB decipher
menusel=9 :'databits
GOSUB decipher
menusel=11 :'stopbits
GOSUB decipher
GOSUB initterm
GOSUB initmenu
MENU ON
ON MENU GOSUB menustuff
term:
ON ERROR GOTO oops
PRINT " ----====>>>> Terminal Mode <<<<====----"
MENU ON
20
IF LOC(2)=1 THEN
IF LOC(2)=1 THEN in$=INPUT$(1,2)
IF ASC(in$)=13 AND lf=1 THEN PRINT
PRINT in$;
IF cap=1 THEN
buff$=buff$+in$
IF lf=1 THEN buff$=buff$+CHR$(10)
END IF
END IF
b$=INKEY$
IF b$<>"" THEN
IF ASC(b$)>128 AND ASC(b$)<139 THEN GOTO macro
PRINT #2,b$;
IF dp=1 THEN PRINT b$;
END IF
GOTO 20
cap:
PRINT "Capture ";
IF cap=1 THEN
PRINT "ON"
PALETTE 0,.78,.05,.05
ELSE
PRINT "OFF"
PALETTE 0,.05,.05,.78
END IF
RETURN
linfd:
PRINT "Linefeeds ";
IF lf=1 THEN PRINT "ON" ELSE PRINT "OFF"
RETURN
sav:
PRINT
PRINT
PRINT "Save Buffer to what filename ";
INPUT file$
CLOSE 5
OPEN file$ FOR OUTPUT AS 5
PRINT #5,buff$;
CLOSE 5
RETURN
lod:
PRINT "Load Buffer"
PRINT
PRINT
PRINT "What filename to load";
INPUT file$
CLOSE 5
OPEN file$ FOR INPUT AS #5
PRINT
PRINT "Length of File = ";LOF(5)
buff$=INPUT$(LOF(5),5)
PRINT
PRINT "Buffer Load Completed."
PRINT
RETURN
initmenu:
MENU 1,0,1,"Misc. "
MENU 1,1,1,"Save Buffer "
MENU 1,2,1,"Load Buffer "
MENU 1,3,1,"Edit Macros "
MENU 1,4,1,"Review Buffer "
MENU 1,5,1,"Show Info "
MENU 1,6,1,"Clear Buffer "
MENU 1,7,1,"Disk Directory"
MENU 1,8,1,"Default Direct"
MENU 1,9,1,"Delete File "
MENU 1,10,1,"Rename File "
MENU 1,11,1,"Print Free Mem"
MENU 2,0,1,"Term Options"
MENU 2,1,cp(1)," Capture Off"
MENU 2,2,cp(2)," Capture On "
ATDT1
MENU 2,3,fl(1)," LF Sim. Off"
MENU 2,4,fl(2)," LF Sim. On "
MENU 2,5,dp(1)," Half Duplex"
MENU 2,6,dp(2)," Full Duplex"
MENU 3,0,1,"Transmit"
MENU 3,1,1,"Normal Upload "
MENU 3,2,1,"Prompt Upload "
MENU 3,3,1,"Xmodem Receive"
MENU 3,4,1,"Xmodem Send "
MENU 4,0,1,"Baud Rate"
MENU 4,1,bd(1)," 110 "
MENU 4,2,bd(2)," 150 "
MENU 4,3,bd(3)," 300 "
MENU 4,4,bd(4)," 600 "
MENU 4,5,bd(5)," 1200 "
MENU 4,6,bd(6)," 1800 "
MENU 4,7,bd(7)," 2400 "
MENU 4,8,bd(8)," 3600 "
MENU 4,9,bd(9)," 4800 "
MENU 4,10,bd(10)," 7200 "
MENU 4,11,bd(11)," 9600 "
MENU 4,12,bd(12)," 19200 "
MENU 5,0,1,"Config"
MENU 5,1,0,"Parity"
MENU 5,2,par(1)," Odd "
MENU 5,3,par(2)," Even "
MENU 5,4,par(3)," None "
MENU 5,5,0,"Data-Bits"
MENU 5,6,db(1)," 5 "
MENU 5,7,db(2)," 6 "
MENU 5,8,db(3)," \ "
MENU 5,9,db(4)," 8 "
MENU 5,10,0,"Stop-Bits"
MENU 5,11,sb(1)," 1 "
MENU 5,12,sb(2)," 2 "
RETURN
file:
ON menusel GOSUB sav,lod,ed,review,info,clearbuf,direct,chdf,killer,ren,mem
GOTO term
trm:
IF menusel=1 THEN cp(1)=2:cp(2)=1
IF menusel=2 THEN cp(2)=2:cp(1)=1
IF menusel=3 THEN fl(1)=2:fl(2)=1
IF menusel=4 THEN fl(2)=2:fl(1)=1
IF menusel=5 THEN dp(1)=2:dp(2)=1
IF menusel=6 THEN dp(2)=2:dp(1)=1
IF first=1 THEN
MENU 2,0,1,"Term Options"
MENU 2,1,cp(1)," Capture Off"
MENU 2,2,cp(2)," Capture On "
MENU 2,3,fl(1)," LF Sim. Off"
MENU 2,4,fl(2)," LF Sim. On "
MENU 2,5,dp(1)," Half Duplex"
MENU 2,6,dp(2)," Full Duplex"
END IF
IF first=1 THEN
IF menusel=1 THEN cap=0:GOTO cap
IF menusel=2 THEN cap=1:GOTO cap
IF menusel=3 THEN lf=0:GOTO linfd
IF menusel=4 THEN lf=1:GOTO linfd
IF menusel=5 THEN dp=1:GOTO duplex
IF menusel=6 THEN dp=0:GOTO duplex
END IF
RETURN
baud:
GOSUB clearbaud
ON menusel GOSUB
bd110,bd150,bd300,bd600,bd1200,bd1800,bd2400,bd3600,bd4800,bd7200,bd9600,bd19200
IF first=1 THEN
MENU 4,0,1,"Baud Rate"
MENU 4,1,bd(1)," 110 "
MENU 4,2,bd(2)," 150 "
MENU 4,3,bd(3)," 300 "
MENU 4,4,bd(4)," 600 "
MENU 4,5,bd(5)," 1200 "
MENU 4,6,bd(6)," 1800 "
MENU 4,7,bd(7)," 2400 "
MENU 4,8,bd(8)," 3600 "
MENU 4,9,bd(9)," 4800 "
MENU 4,10,bd(10)," 7200 "
MENU 4,11,bd(11)," 9600 "
MENU 4,12,bd(12)," 19200 "
END IF
IF first=1 THEN GOSUB initterm ELSE RETURN
RETURN
bd110:
baud$="110"
bd(1)=2
RETURN
bd150:
baud$="150"
bd(2)=2
RETURN
bd300:
baud$="300"
bd(3)=2
RETURN
bd600:
baud$="600"
bd(4)=2
RETURN
bd1200:
baud$="1200"
bd(5)=2
RETURN
bd1800:
baud$="1800"
bd(6)=2
RETURN
bd2400:
baud$="2400"
bd(7)=2
RETURN
bd3600:
baud$="3600"
bd(8)=2
RETURN
bd4800:
baud$="4800"
bd(9)=2
RETURN
bd7200:
baud$="7200"
bd(10)=2
RETURN
bd9600:
baud$="9600"
bd(11)=2
RETURN
bd19200:
baud$="19200"
bd(12)=2
RETURN
clearbaud:
FOR i=1 TO 12
bd(i)=1
NEXT i
RETURN
initterm:
com$=F$
comma$=","
com$=com$+baud$
com$=com$+comma$
com$=com$+parity$
com$=com$+comma$
com$=com$+databit$
com$=com$+comma$
com$=com$+stopbits$
first=1
ON ERROR GOTO oops
CLOSE 2
OPEN com$ AS #2 LEN=128
CLS
PRINT "RS232 configured to: ";
PRINT baud$;" Baud - ";
IF parity$="N" THEN PRINT "No Parity";
IF parity$="E" THEN PRINT "Even Parity";
IF parity$="O" THEN PRINT "Odd Parity";
PRINT " - ";
PRINT " ";databit$;" Databits - ";
PRINT stopbits$;" Stopbit(s)."
PRINT
RETURN
parity:
par(1)=1
par(2)=1
par(3)=1
par(menusel)=2
IF menusel=1 THEN parity$="O"
IF menusel=2 THEN parity$="E"
IF menusel=3 THEN parity$="N"
IF first=1 THEN GOSUB initconfig
IF first=1 THEN GOSUB initterm
RETURN
databits:
db(1)=1
db(2)=1
db(3)=1
db(4)=1
db(menusel)=2
IF menusel=1 THEN databit$="5"
IF menusel=2 THEN databit$="6"
IF menusel=3 THEN databit$="7"
IF menusel=4 THEN databit$="8"
IF first=1 THEN GOSUB initconfig
IF first=1 THEN GOSUB initterm
RETURN
stopbits:
sb(1)=1
sb(2)=1
sb(menusel)=2
IF menusel=1 THEN stopbits$="1"
IF menusel=2 THEN stopbits$="2"
IF first=1 THEN GOSUB initconfig:GOSUB initterm
RETURN
menustuff:
menuid=MENU(0)
menusel=MENU(1)
ON menuid GOSUB file,trm,trans,baud,decipher
MENU ON
RETURN
oops:
CLOSE #5
BEEP
IF ERR=64 THEN PRINT " Invalid RS232 Mode!!"
IF ERR=64 THEN PRINT " Try Other Paramaters"
IF ERR<>64 THEN PRINT "Error - ";ERR:MENU ON:RESUME term
PRINT
PRINT
MENU ON
10 IF MENU(0)<>0 THEN RESUME erormenu ELSE GOTO 10
erormenu:
menusel=MENU(1)
ON menuid GOSUB file,trm,trans,baud,decipher
MENU ON
GOTO term
decipher:
IF menusel<5 THEN menusel=menusel-1:GOTO parity
IF menusel<10 THEN menusel=menusel-5:GOTO databits
IF menusel<13 THEN menusel=menusel-10:GOTO stopbits
initconfig:
MENU 5,0,1,"Config"
MENU 5,1,0,"Parity"
MENU 5,2,par(1)," Odd "
MENU 5,3,par(2)," Even "
MENU 5,4,par(3)," None "
MENU 5,5,0,"Data-Bits"
MENU 5,6,db(1)," 5 "
MENU 5,7,db(2)," 6 "
MENU 5,8,db(3)," 7 "
MENU 5,9,db(4)," 8 "
MENU 5,10,0,"Stop-Bits"
MENU 5,11,sb(1)," 1 "
MENU 5,12,sb(2)," 2 "
RETURN
trans:
IF menusel=1 THEN normup
IF menusel=2 THEN prmptup
IF menusel=3 THEN xrec
IF menusel=4 THEN xsend
normup:
ln=LEN(buff$)
FOR i=1 TO ln
PRINT #2,MID$(buff$,i,1);
IF INKEY$<>"" THEN
PRINT
PRINT
PRINT" Aborted!!!!!"
PRINT
GOTO tATDT1
erm
END IF
NEXT i
PRINT
PRINT " Normal Buffer Upload Completed."
PRINT
GOTO term
prmptup:
ln=LEN(buff$)
FOR i=1 TO ln
PRINT #2,MID$(buff$,i,1);
IF ASC(MID$(buff$,i,1))=13 THEN GOSUB waitprompt
IF INKEY$<>"" THEN
PRINT
PRINT
PRINT "Aborted !!!"
PRINT
GOTO term
END IF
NEXT i
GOTO term
waitprompt:
IF LOC(2)=1 THEN
qw$= INPUT$(1,2)
IF qw$<>prompt$ THEN waitprompt ELSE RETURN
END IF
xrec:
PRINT
PRINT "Receive what Filename";:INPUT file$
IF file$="" THEN abort
CLOSE #3
OPEN file$ FOR OUTPUT AS #3
timeout=500
ack$=CHR$(6)
nak$=CHR$(21)
eot$=CHR$(4)
blawck=1
n=1
eotflag=0
jr$=nak$:GOSUB princhr
30 bf$="":t=0:r$="":tim=0:chsum=0
FOR t=1 TO 132
50 r$=""
IF LOC(2)=1 THEN
r$=INPUT$(1,2)
bf$=bf$+r$
tim=0
PRINT ".";
ELSE
tim=tim+1
END IF
IF t=1 THEN IF bf$=eot$ THEN 40
IF tim>timeout THEN
PRINT "Timeout"
jr$=nak$
GOSUB princhr
t=0
tim=0
GOTO 30
END IF
IF r$="" THEN 50
NEXT t
chsum=0
GOSUB checksummer
IF chsum=ASC(RIGHT$(bf$,1)) THEN
PRINT #3,MID$(bf$,4,127);
PRINT " Received Block ";blawck
jr$=ack$:GOSUB princhr
PRINT
blawck=blawck+1
GOTO 30
ELSE
BEEP
PRINT "Checksum Error in Block ";blawck
PRINT "I get ";chsum;
PRINT ". And He get's ";ASC(RIGHT$(bf$,1))
jd$=ack$:GOSUB princhr
PRINT
END IF
GOTO 30
40 CLOSE #3
PRINT #2,ack$;
PRINT "File Transfer is Completed."
GOTO term
checksum:
chsum=0
FOR i=1 TO 128
chsum=chsum+ASC(MID$(bf$,i,1)) AND 255
NEXT i
RETURN
xsend:
PRINT
PRINT"Send what filename";
INPUT file$
IF file$="" THEN abort
ack$=CHR$(6)
block=0
nak$=CHR$(21)
eot$=CHR$(4)
CLOSE 3
OPEN file$ FOR INPUT AS #3
ln=LOF(3)
PRINT "Length of File ";ln;". ";
n=ln/128
IF INT(n) < n THEN n=INT(n)+1 ELSE n=INT(n)
PRINT n;" Blocks."
bf$=""
80 GOSUB waitchar
IF char$<>nak$ THEN 80
75 IF ln>127 THEN bf$=INPUT$(128,3) ELSE GOSUB getrest
ln=ln-128
block=block+1
90 PRINT " Sending Block";block
GOSUB stuff
PRINT #2,bf$;
GOSUB checksum
PRINT #2,CHR$(chsum);
GOSUB waitchar
IF char$=nak$ THEN BEEP:PRINT "Checksum Error in block";block:GOTO 90
IF char$=ack$ AND ed=0 THEN 75
IF char$=ack$ AND ed=1 THEN PRINT #2,eot$
IF char$<>nak$ AND char$<>ack$ THEN PRINT "Connection Aborts Transfer":PRINT
:GOTO term
ed=0
PRINT "File Transfer Complete."
GOTO term
waitchar:
IF LOC(2)=1 THEN
IF LOC(2)=1 THEN char$=INPUT$(1,2)
RETURN
END IF
GOTO waitchar
getrest:
bf$=""
bf$=INPUT$(ln,3)
FOR i=ln+1 TO 128
bf$=bf$+" "
NEXT i
ed=1
RETURN
stuff:
PRINT #2,CHR$(1);
PRINT #2,CHR$(block AND 255);
PRINT #2,CHR$((block AND 255)XOR 255);
RETURN
checksummer:
chsum=0
FOR i=1 TO 131
chsum=chsum+ASC(MID$(bf$,i,1)) AND 255
NEXT i
RETURN
duplex:
IF dp=1 THEN PRINT :PRINT "Half Duplex"
IF dp=0 THEN PRINT :PRINT "Full Duplex"
RETURN
ed:
CLS
PRINT
PRINT
PRINT " Current Macro's"
FOR i=1 TO 10
PRINT "F";i;":=";mac$(i)
NEXT i
PRINT
INPUT "Edit Which Macro (0 to Exit)",which
IF which=0 AND change=1 THEN dump
IF which=0 AND change=0 THEN term
PRINT
PRINT "Input New Macro to be used for key F";STR$(which);"."
LINE INPUT mac$(which)
IF mac$(which)="" THEN mac$(which)="Undefined"
change=1
GOTO ed
dump:
CLOSE 3
OPEN "Macro" FOR OUTPUT AS #3
FOR i=1 TO 10
PRINT #3,mac$(i)
NEXT i
CLOSE 3
change=0
GOTO term
gettem:
ON ERROR GOTO macerr
CLOSE #3
OPEN "Macro" FOR INPUT AS #3
FOR i=1 TO 10
LINE INPUT #3,mac$(i)
NEXT i
CLOSE 3
RETURN
macerr:
IF ERR=53 THEN
CLOSE 3
OPEN "Macro" FOR OUTPUT AS #3
FOR i=1 TO 10
PRINT #3,"Undefined"
NEXT i
CLOSE 3
END IF
MENU ON
RESUME gettem
macro:
g=ASC(b$)
g=g-128
IF mac$(g)="Undefined" THEN y=1 ELSE y=0
hy=INSTR(mac$(g),"[RET]")
IF hy=0 AND y=0 THEN PRINT #2,mac$(g);
IF hy=0 AND dp=1 AND y=0 THEN PRINT mac$(g);
IF hy<>0 AND y=0 THEN PRINT #2,MID$(mac$(g),1,hy-1)
IF hy<>0 AND dp=1 AND y=0 THEN PRINT #2,MID$(mac$(g),1,hy-1)
GOTO 20
review:
FOR i=1 TO LEN(buff$) STEP 4
PRINT MID$(buff$,i,4);
IF INKEY$<>"" THEN RETURN
NEXT i
RETURN
info:
WINDOW 5,,(70,50)-(540,140),0,-1
PRINT " Info"
PRINT
PRINT " SuperTerm V1.0 was written by Kelly Kauffman to be used"
PRINT "EXCLUSIVELY on the Amiga. The Program was written in "
PRINT "Microsoft Basic, and requires an Amiga with 512K."
PRINT
PRINT " Program & Audio-Visual Copyright 1986"
PRINT " Kelly Kauffman"
PRINT
PRINT "This program may not be sold for ANY PRICE without consent"
PRINT "of the author. Please feel free, however, to distribute"
INPUT "free copies of this program. Press [RETURN] ";a$
WINDOW CLOSE (5)
WINDOW (1)
WINDOW OUTPUT (1)
RETURN
clearbuf:
buff$=""
bf$=""
PRINT
PRINT "Buffer Cleared"
PRINT
RETURN
princhr:
CLOSE #2
OPEN com$ AS #2 LEN=1000
FOR uip=1 TO 200:NEXT uip
PRINT #2,jr$;
RETURN
direct:
PRINT
PRINT "Directory Pathname [Or Press Return to use Default Pathname]"
INPUT path$
PRINT
FILES path$
RETURN
chdf:
PRINT
PRINT "Enter pathname to be used as the Default Directory"
INPUT ty$
CHDIR ty$
PRINT
RETURN
killer:
PRINT
PRINT "Enter Filename to delete";
INPUT ty$
PRINT "Are you Sure (y/n)ATDT1
";
INPUT yn$
IF yn$<>"Y" AND yn$<>"y" THEN
PRINT "File --==>>NOT<<==-- Deleted"
RETURN
ELSE
KILL ty$
END IF
PRINT ty$;" is gone!!!"
PRINT
RETURN
ren:
PRINT
PRINT "Rename:"
PRINT "Input OLD filename to rename";
INPUT oldfil$
PRINT
PRINT "Input NEW name for the file";
INPUT newfil$
NAME oldfil$ AS newfil$
PRINT
PRINT oldfil$;" is now called ";newfil$;"."
PRINT
RETURN
breaker:
PRINT #2,CHR$(3);
RETURN
mem:
PRINT
PRINT FRE(-1);" Bytes of Memory Remain."
PRINT
RETURN